home *** CD-ROM | disk | FTP | other *** search
/ Atari Mega Archive 1 / Atari Mega Archive - Volume 1.iso / language / xlisp_21.zoo / xlspeed.dif < prev    next >
Internet Message Format  |  1990-02-28  |  47KB
  1. From sce!mitel!uunet!lll-winken!ames!haven!umd5!jonnyg Tue May 23 15:37:24 EDT 1989
  2. Article: 91 of comp.lang.lisp.x
  3. Path: cognos!sce!mitel!uunet!lll-winken!ames!haven!umd5!jonnyg
  4. From: jonnyg@umd5.umd.edu (Jon Greenblatt)
  5. Newsgroups: comp.lang.lisp.x
  6. Subject: Xlisp2.0 speedups... (Part 1 of 3)
  7. Message-ID: <4912@umd5.umd.edu>
  8. Date: 18 May 89 16:58:56 GMT
  9. Reply-To: jonnyg@umd5.umd.edu (Jon Greenblatt)
  10. Organization: University of Maryland, College Park
  11. Lines: 910
  12.  
  13. The following are changes I have made to xlisp 2.0 source. Most of these
  14. changes produce considerable speed ups. This distribution is very
  15. rough but maybe someone can wade through it and come of with a cleaned
  16. up version of the speed ups. Note this is a striaght context diff so
  17. more than just the speed ups are included, BEWARE! If you are able to
  18. clean up or enhance these speed ups in any way I would apreciate the
  19. feedback.
  20.  
  21.                 JonnyG.
  22.  
  23. diff -c ../xlisp.org/xlbfun.c ../xlisp/xlbfun.c
  24. *** ../xlisp.org/xlbfun.c    Sun May  7 22:25:38 1989
  25. --- ../xlisp/xlbfun.c    Wed Apr  5 16:18:23 1989
  26. ***************
  27. *** 558,563 ****
  28. --- 558,578 ----
  29.       return (val);
  30.   }
  31.   
  32. + LVAL xcopyarray()
  33. + {
  34. +     LVAL src, dest;
  35. +     int num;
  36. +     register int i;
  37. + 
  38. +     src = xlgavector();
  39. +     dest = xlgavector();
  40. +     xllastarg();
  41. +     num = (getsize(src) < getsize(dest)) ? getsize(src) : getsize(dest);
  42. +     for (i = 0; i < num; i++)
  43. +         setelement(dest,i,getelement(src,i));
  44. +     return(dest);
  45. + }
  46. + 
  47.   /* xerror - special form 'error' */
  48.   LVAL xerror()
  49.   {
  50. diff -c ../xlisp.org/xldbug.c ../xlisp/xldbug.c
  51. *** ../xlisp.org/xldbug.c    Sun May  7 22:25:43 1989
  52. --- ../xlisp/xldbug.c    Wed Apr  5 16:18:24 1989
  53. ***************
  54. *** 14,20 ****
  55.   extern char buf[];
  56.   
  57.   /* external routines */
  58. ! extern char *malloc();
  59.   
  60.   /* forward declarations */
  61.   FORWARD LVAL stacktop();
  62. --- 14,20 ----
  63.   extern char buf[];
  64.   
  65.   /* external routines */
  66. ! extern char *xlmalloc();
  67.   
  68.   /* forward declarations */
  69.   FORWARD LVAL stacktop();
  70. diff -c ../xlisp.org/xldmem.c ../xlisp/xldmem.c
  71. *** ../xlisp.org/xldmem.c    Sun May  7 22:25:46 1989
  72. --- ../xlisp/xldmem.c    Wed Apr  5 16:18:25 1989
  73. ***************
  74. *** 6,13 ****
  75.   #include "xlisp.h"
  76.   
  77.   /* node flags */
  78. ! #define MARK    1
  79. ! #define LEFT    2
  80.   
  81.   /* macro to compute the size of a segment */
  82.   #define segsize(n) (sizeof(SEGMENT)+((n)-1)*sizeof(struct node))
  83. --- 6,13 ----
  84.   #include "xlisp.h"
  85.   
  86.   /* node flags */
  87. ! #define MARK    0x20
  88. ! #define LEFT    0x40
  89.   
  90.   /* macro to compute the size of a segment */
  91.   #define segsize(n) (sizeof(SEGMENT)+((n)-1)*sizeof(struct node))
  92. ***************
  93. *** 21,37 ****
  94.   SEGMENT *segs,*lastseg,*fixseg,*charseg;
  95.   int anodes,nsegs,gccalls;
  96.   long nnodes,nfree,total;
  97. ! LVAL fnodes;
  98.   
  99.   /* external procedures */
  100. ! extern char *malloc();
  101. ! extern char *calloc();
  102.   
  103.   /* forward declarations */
  104. ! FORWARD LVAL newnode();
  105.   FORWARD unsigned char *stralloc();
  106.   FORWARD SEGMENT *newsegment();
  107.   
  108.   /* cons - construct a new cons node */
  109.   LVAL cons(x,y)
  110.     LVAL x,y;
  111. --- 21,50 ----
  112.   SEGMENT *segs,*lastseg,*fixseg,*charseg;
  113.   int anodes,nsegs,gccalls;
  114.   long nnodes,nfree,total;
  115. ! LVAL fnodes = NIL;
  116.   
  117.   /* external procedures */
  118. ! extern char *xlmalloc();
  119. ! extern char *xlcalloc();
  120.   
  121.   /* forward declarations */
  122. ! FORWARD LVAL Newnode();
  123.   FORWARD unsigned char *stralloc();
  124.   FORWARD SEGMENT *newsegment();
  125.   
  126. + LVAL _nnode;
  127. + FIXTYPE _tfixed;
  128. + int _tint;
  129. + 
  130. + #define    newnode(type) (((_nnode = fnodes) != NIL) ? \
  131. +             ((fnodes = cdr(_nnode)), \
  132. +              nfree--, \
  133. +              (_nnode->n_type = type), \
  134. +              rplacd(_nnode,NIL), \
  135. +              _nnode) \
  136. +             : (_nnode = Newnode(type)))
  137. + 
  138. + 
  139.   /* cons - construct a new cons node */
  140.   LVAL cons(x,y)
  141.     LVAL x,y;
  142. ***************
  143. *** 129,140 ****
  144.   }
  145.   
  146.   /* cvfixnum - convert an integer to a fixnum node */
  147. ! LVAL cvfixnum(n)
  148.     FIXTYPE n;
  149.   {
  150.       LVAL val;
  151. -     if (n >= SFIXMIN && n <= SFIXMAX)
  152. -     return (&fixseg->sg_nodes[(int)n-SFIXMIN]);
  153.       val = newnode(FIXNUM);
  154.       val->n_fixnum = n;
  155.       return (val);
  156. --- 142,151 ----
  157.   }
  158.   
  159.   /* cvfixnum - convert an integer to a fixnum node */
  160. ! LVAL Cvfixnum(n)
  161.     FIXTYPE n;
  162.   {
  163.       LVAL val;
  164.       val = newnode(FIXNUM);
  165.       val->n_fixnum = n;
  166.       return (val);
  167. ***************
  168. *** 151,157 ****
  169.   }
  170.   
  171.   /* cvchar - convert an integer to a character node */
  172. ! LVAL cvchar(n)
  173.     int n;
  174.   {
  175.       if (n >= CHARMIN && n <= CHARMAX)
  176. --- 162,168 ----
  177.   }
  178.   
  179.   /* cvchar - convert an integer to a character node */
  180. ! LVAL Cvchar(n)
  181.     int n;
  182.   {
  183.       if (n >= CHARMIN && n <= CHARMAX)
  184. ***************
  185. *** 180,185 ****
  186. --- 191,225 ----
  187.       return (val);
  188.   }
  189.   
  190. + #ifdef    WINDOWS
  191. + LVAL newwinobj(size)
  192. + int size;
  193. + {
  194. +     LVAL val;
  195. +     val = newnode(WINOBJ);
  196. +     if (size > 0) {
  197. +         xlprot1(val);
  198. +         if ((val->n_winobj = xldcalloc(1,size)) == NULL) {
  199. +             findmem();
  200. +             if ((val->n_winobj = xldcalloc(1,size)) == NULL)
  201. +                 xlfail("insufficient memory");
  202. +             }
  203. +         xlpop();
  204. +         }
  205. +     else val->n_winobj = NULL;
  206. +     return(val);
  207. + }
  208. + 
  209. + LVAL cvwinobj(p)
  210. + char *p;
  211. +     {
  212. +     LVAL val;
  213. +     val = newnode(WINOBJ);
  214. +     val->n_winobj = p;
  215. +     return(val);
  216. +     }
  217. + #endif
  218. + 
  219.   /* newclosure - allocate and initialize a new closure */
  220.   LVAL newclosure(name,type,env,fenv)
  221.     LVAL name,type,env,fenv;
  222. ***************
  223. *** 204,212 ****
  224.       vect = newnode(VECTOR);
  225.       vect->n_vsize = 0;
  226.       if (bsize = size * sizeof(LVAL)) {
  227. !     if ((vect->n_vdata = (LVAL *)calloc(1,bsize)) == NULL) {
  228.           findmem();
  229. !         if ((vect->n_vdata = (LVAL *)calloc(1,bsize)) == NULL)
  230.           xlfail("insufficient vector space");
  231.       }
  232.       vect->n_vsize = size;
  233. --- 244,252 ----
  234.       vect = newnode(VECTOR);
  235.       vect->n_vsize = 0;
  236.       if (bsize = size * sizeof(LVAL)) {
  237. !     if ((vect->n_vdata = (LVAL *)xldcalloc(1,bsize)) == NULL) {
  238.           findmem();
  239. !         if ((vect->n_vdata = (LVAL *)xldcalloc(1,bsize)) == NULL)
  240.           xlfail("insufficient vector space");
  241.       }
  242.       vect->n_vsize = size;
  243. ***************
  244. *** 217,223 ****
  245.   }
  246.   
  247.   /* newnode - allocate a new node */
  248. ! LOCAL LVAL newnode(type)
  249.     int type;
  250.   {
  251.       LVAL nnode;
  252. --- 257,263 ----
  253.   }
  254.   
  255.   /* newnode - allocate a new node */
  256. ! LVAL Newnode(type)
  257.     int type;
  258.   {
  259.       LVAL nnode;
  260. ***************
  261. *** 248,256 ****
  262.       unsigned char *sptr;
  263.   
  264.       /* allocate memory for the string copy */
  265. !     if ((sptr = (unsigned char *)malloc(size)) == NULL) {
  266.       gc();  
  267. !     if ((sptr = (unsigned char *)malloc(size)) == NULL)
  268.           xlfail("insufficient string space");
  269.       }
  270.       total += (long)size;
  271. --- 288,296 ----
  272.       unsigned char *sptr;
  273.   
  274.       /* allocate memory for the string copy */
  275. !     if ((sptr = (unsigned char *)xldmalloc(size)) == NULL) {
  276.       gc();  
  277. !     if ((sptr = (unsigned char *)xldmalloc(size)) == NULL)
  278.           xlfail("insufficient string space");
  279.       }
  280.       total += (long)size;
  281. ***************
  282. *** 330,336 ****
  283.     LVAL ptr;
  284.   {
  285.       register LVAL this,prev,tmp;
  286. !     int type,i,n;
  287.   
  288.       /* initialize */
  289.       prev = NIL;
  290. --- 370,376 ----
  291.     LVAL ptr;
  292.   {
  293.       register LVAL this,prev,tmp;
  294. !     register int i,n;
  295.   
  296.       /* initialize */
  297.       prev = NIL;
  298. ***************
  299. *** 340,380 ****
  300.       for (;;) {
  301.   
  302.       /* descend as far as we can */
  303. !     while (!(this->n_flags & MARK))
  304.   
  305.           /* check cons and symbol nodes */
  306. !         if ((type = ntype(this)) == CONS) {
  307. !         if (tmp = car(this)) {
  308. !             this->n_flags |= MARK|LEFT;
  309. !             rplaca(this,prev);
  310. !         }
  311. !         else if (tmp = cdr(this)) {
  312. !             this->n_flags |= MARK;
  313.               rplacd(this,prev);
  314. !         }
  315. !         else {                /* both sides nil */
  316. !             this->n_flags |= MARK;
  317.               break;
  318. !         }
  319. !         prev = this;            /* step down the branch */
  320. !         this = tmp;
  321. !         }
  322. ! 
  323. !         /* mark other node types */
  324.           else {
  325. !         this->n_flags |= MARK;
  326. !         switch (type) {
  327. !         case SYMBOL:
  328. !         case OBJECT:
  329. !         case VECTOR:
  330. !         case CLOSURE:
  331. !             for (i = 0, n = getsize(this); --n >= 0; ++i)
  332. !             if (tmp = getelement(this,i))
  333. !                 mark(tmp);
  334. !             break;
  335. !         }
  336. !         break;
  337. !         }
  338.   
  339.       /* backup to a point where we can continue descending */
  340.       for (;;)
  341. --- 380,409 ----
  342.       for (;;) {
  343.   
  344.       /* descend as far as we can */
  345. !     while (!(this->n_type & MARK))
  346.   
  347.           /* check cons and symbol nodes */
  348. !         if ((i = (this->n_type |= MARK) & TY